library(opendatascot)
library(tidyverse)
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ─────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
✓ ggplot2 3.3.3     ✓ purrr   0.3.4
✓ tibble  3.0.6     ✓ dplyr   1.0.2
✓ tidyr   1.1.2     ✓ stringr 1.4.0
✓ readr   1.4.0     ✓ forcats 0.5.0
── Conflicts ────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
ods_all_datasets() %>% 
  janitor::clean_names() %>% 
  filter(name == "Life Expectancy") %>% 
  select(uri)
male_hle_data <- read_csv("data/raw_data/male-healthy-life-expectancy.csv",skip = 10)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────
cols(
  `http://purl.org/linked-data/sdmx/2009/dimension#refArea` = col_character(),
  `Reference Area` = col_character(),
  `2015-2017` = col_double(),
  `2016-2018` = col_double(),
  `2017-2019` = col_double()
)
female_hle_data <- read_csv("data/raw_data/female-healthy-life-expectancy.csv", skip = 10)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────
cols(
  `http://purl.org/linked-data/sdmx/2009/dimension#refArea` = col_character(),
  `Reference Area` = col_character(),
  `2015-2017` = col_double(),
  `2016-2018` = col_double(),
  `2017-2019` = col_double()
)
hb_shapes <- readOGR(
  dsn ="data/simplified_shapefiles/health_boards/NHS_HealthBoards_2019/",
  layer = "NHS_HealthBoards_2019",
  GDAL1_integer64_policy = TRUE)
Discarded datum OSGB_1936 in CRS definition: +proj=tmerc +lat_0=49 +lon_0=-2 +k=0.9996012717 +x_0=400000 +y_0=-100000 +ellps=airy +units=m +no_defs
OGR data source with driver: ESRI Shapefile 
Source: "/Users/user/scot_stats_dashboard/data/simplified_shapefiles/health_boards/NHS_HealthBoards_2019", layer: "NHS_HealthBoards_2019"
with 14 features
It has 4 fields
library(rgeos)
rgeos version: 0.5-5, (SVN revision 640)
 GEOS runtime version: 3.8.1-CAPI-1.13.3 
 Linking to sp version: 1.4-2 
 Polygon checking: TRUE 
hb_simple <- gSimplify(hb_shapes, tol = 0.025, topologyPreserve = TRUE)

56.3950° N, 3.4308° W

uk_shape <- readOGR(
   dsn ="../Downloads/scot_stats_dashboard/bdline_essh_gb/Data/GB/",
   layer = "county_region",
   GDAL1_integer64_policy = TRUE)
Discarded datum OSGB_1936 in CRS definition: +proj=tmerc +lat_0=49 +lon_0=-2 +k=0.9996012717 +x_0=400000 +y_0=-100000 +ellps=airy +units=m +no_defs
OGR data source with driver: ESRI Shapefile 
Source: "/Users/user/Downloads/scot_stats_dashboard/bdline_essh_gb/Data/GB", layer: "county_region"
with 26 features
It has 15 fields
Integer64 fields read as doubles:  NUMBER NUMBER0 POLYGON_ID UNIT_ID 
 
 uk_simple <- gSimplify(uk_shape, tol = 0.025, topologyPreserve = TRUE)
plot(uk_simple)
library(maps)

Attaching package: ‘maps’

The following object is masked from ‘package:purrr’:

    map
UK <- map_data("world") %>% filter(region == "UK")
UK
library(broom)
hle_map_data <- spdf_fortified %>% 
  left_join(hb_lookup, by = c("id" = "id")) %>% 
  left_join(hle_data, by = c("hb_name" = "reference_area"))
library(plotly)
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout
hle_data <- read_csv("data/clean_data/healthy_life_expectancy.csv")

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────
cols(
  area_code = col_character(),
  reference_area = col_character(),
  reference_period = col_character(),
  sex = col_character(),
  measurement = col_double()
)
ref_period_var <- "2015-2017"
sex_var <- "male"


user_selections <- list(
  reference_period = "2015-2017",
  sex = "male"
)
user_selections
$ref_period
[1] "2015-2017"

$sex
[1] "male"
filtered_hle_data <- filter_df(hle_data, user_selections)
my_map
hb_shapes@data <- hb_shapes@data %>% 
  janitor::clean_names() %>% 
  left_join(hle_2015_m, by = c("hb_name" = "reference_area"))
labels <- sprintf("<strong>%s</strong><br/>%g years",
                  hb_shapes$hb_name, hb_shapes$healthy_life_expectancy) %>%
  lapply(htmltools::HTML)
# add Health Board polygons, colour based on LE, highlight on hover

my_map %>% 
    addPolygons(data = hb_shapes, color = "white",
                fillColor = ~colorQuantile(
                  "YlOrRd", (-hb_shapes$healthy_life_expectancy))
                (-hb_shapes$healthy_life_expectancy),
                weight = 1, fillOpacity = 0.9, label = labels,
                highlightOptions = highlightOptions(
                  color = "black", weight = 2,
                  opacity = 0.9, bringToFront = TRUE))
LS0tCnRpdGxlOiAiRGF0YSBFeHRyYWN0YWN0aW9uIGFuZCBFeHBsb3JhdGlvbiIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CmxpYnJhcnkob3BlbmRhdGFzY290KQpsaWJyYXJ5KHRpZHl2ZXJzZSkKYGBgCgpgYGB7cn0Kb2RzX2FsbF9kYXRhc2V0cygpICU+JSAKICBqYW5pdG9yOjpjbGVhbl9uYW1lcygpICU+JSAKICBmaWx0ZXIobmFtZSA9PSAiTGlmZSBFeHBlY3RhbmN5IikgJT4lIAogIHNlbGVjdCh1cmkpCmBgYAoKCmBgYHtyfQpsaWJyYXJ5KHJnZGFsKQpgYGAKCmBgYHtyfQpoYl9zaGFwZXMgPC0gcmVhZE9HUigKICBkc24gPSJkYXRhL3NpbXBsaWZpZWRfc2hhcGVmaWxlcy9oZWFsdGhfYm9hcmRzL05IU19IZWFsdGhCb2FyZHNfMjAxOS8iLAogIGxheWVyID0gIk5IU19IZWFsdGhCb2FyZHNfMjAxOSIsCiAgR0RBTDFfaW50ZWdlcjY0X3BvbGljeSA9IFRSVUUpCmBgYAoKCmBgYHtyfQpsaWJyYXJ5KHJnZW9zKQpgYGAKCmBgYHtyfQpoYl9zaW1wbGUgPC0gZ1NpbXBsaWZ5KGhiX3NoYXBlcywgdG9sID0gMC4wMDUsIHRvcG9sb2d5UHJlc2VydmUgPSBUUlVFKQpgYGAKCgpgYGB7cn0KaGJfbG9va3VwIDwtIGhiX3NoYXBlc0BkYXRhICU+JSAKICBzZWxlY3QoMSwyKSAlPiUgCiAgcm93aWRfdG9fY29sdW1uKCJpZCIpICU+JQogIG11dGF0ZShpZCA9IGFzLmNoYXJhY3RlcihpZC0xKSkgJT4lIAogIGphbml0b3I6OmNsZWFuX25hbWVzKCkKYGBgCgo1Ni4zOTUwwrAgTiwgMy40MzA4wrAgVwoKYGBge3J9CnBsb3QoaGJfc2ltcGxlLCB4bGltID0gYygtMy42NiwgLTMuNTApLCB5bGltID0gYyg1NSw2MSkpCmBgYAoKYGBge3J9CnVrX3NoYXBlIDwtIHJlYWRPR1IoCiAgIGRzbiA9Ii4uL0Rvd25sb2Fkcy9zY290X3N0YXRzX2Rhc2hib2FyZC9iZGxpbmVfZXNzaF9nYi9EYXRhL0dCLyIsCiAgIGxheWVyID0gImNvdW50eV9lbGVjdCIsCiAgIEdEQUwxX2ludGVnZXI2NF9wb2xpY3kgPSBUUlVFKQogCiB1a19zaW1wbGUgPC0gZ1NpbXBsaWZ5KHVrX3NoYXBlLCB0b2wgPSAwLjEsIHRvcG9sb2d5UHJlc2VydmUgPSBUUlVFKQpgYGAKCmBgYHtyfQpwbG90KHVrX3NpbXBsZSkKYGBgCgoKCgoKYGBge3J9CmxpYnJhcnkobWFwcykKYGBgCgoKYGBge3J9ClVLIDwtIG1hcF9kYXRhKCJ3b3JsZCIpICU+JSBmaWx0ZXIocmVnaW9uID09ICJVSyIpCmBgYAoKCmBgYHtyfQpVSwpgYGAKCgoKYGBge3J9CmxpYnJhcnkoYnJvb20pCmBgYAoKCmBgYHtyfQpzcGRmX2ZvcnRpZmllZCA8LSB0aWR5KGhiX3NpbXBsZSwgcmVnaW9uID0gImNvZGUiKQpgYGAKCgoKYGBge3J9CnNwZGZfZm9ydGlmaWVkCmBgYAoKYGBge3J9CmhsZV9tYXBfZGF0YSA8LSBzcGRmX2ZvcnRpZmllZCAlPiUgCiAgbGVmdF9qb2luKGhiX2xvb2t1cCwgYnkgPSBjKCJpZCIgPSAiaWQiKSkgJT4lIAogIGxlZnRfam9pbihobGVfZGF0YSwgYnkgPSBjKCJoYl9uYW1lIiA9ICJyZWZlcmVuY2VfYXJlYSIpKQpgYGAKCmBgYHtyfQpsaWJyYXJ5KHBsb3RseSkKYGBgCgoKYGBge3J9CmhsZV9kYXRhIDwtIHJlYWRfY3N2KCJkYXRhL2NsZWFuX2RhdGEvaGVhbHRoeV9saWZlX2V4cGVjdGFuY3kuY3N2IikKYGBgCgpgYGB7cn0KcmVmX3BlcmlvZF92YXIgPC0gIjIwMTUtMjAxNyIKc2V4X3ZhciA8LSAibWFsZSIKCgp1c2VyX3NlbGVjdGlvbnMgPC0gbGlzdCgKICByZWZlcmVuY2VfcGVyaW9kID0gIjIwMTUtMjAxNyIsCiAgc2V4ID0gIm1hbGUiCikKYGBgCgpgYGB7cn0KdXNlcl9zZWxlY3Rpb25zCmBgYAoKYGBge3J9CgoKYGBgCgoKYGBge3J9IApmaWx0ZXJlZF9obGVfZGF0YSA8LSBmaWx0ZXJfZGYoaGxlX2RhdGEsIHVzZXJfc2VsZWN0aW9ucykKYGBgCgoKYGBge3J9CmZpbHRlcmVkX2hsZV9kYXRhCmBgYAoKCmBgYHtyfQpsaWJyYXJ5KGxlYWZsZXQpCmBgYAoKYGBge3J9Cm15X21hcCA8LSBsZWFmbGV0KG9wdGlvbnMgPSBsZWFmbGV0T3B0aW9ucyhtaW5ab29tID0gNikpICU+JQogICAgc2V0VmlldyhsbmcgPSAtNSwgbGF0ID0gNTcuMzUsIHpvb20gPSA2KSAlPiUKICAgICMgcmVzdHJpY3QgdmlldyB0byBhcm91bmQgU2NvdGxhbmQKICAgIHNldE1heEJvdW5kcyhsbmcxID0gLTEsCiAgICAgICAgICAgICAgICAgbGF0MSA9IDUwLAogICAgICAgICAgICAgICAgIGxuZzIgPSAtOSwKICAgICAgICAgICAgICAgICBsYXQyID0gNjQpICU+JSAKICBhZGRQcm92aWRlclRpbGVzKHByb3ZpZGVycyRDYXJ0b0RCLlBvc2l0cm9uTm9MYWJlbHMpCmBgYAoKCmBgYHtyfQpteV9tYXAKYGBgCgoKCmBgYHtyfQpobGVfMjAxNV9tIDwtIGhsZV9kYXRhICU+JSAKICBmaWx0ZXIoc2V4ID09ICJtYWxlIikgJT4lIAogIGZpbHRlcihyZWZfcGVyaW9kID09ICIyMDE1LTIwMTciKQpgYGAKCgoKCmBgYHtyfQpoYl9zaGFwZXNAZGF0YSA8LSBoYl9zaGFwZXNAZGF0YSAlPiUgCiAgamFuaXRvcjo6Y2xlYW5fbmFtZXMoKSAlPiUgCiAgbGVmdF9qb2luKGhsZV8yMDE1X20sIGJ5ID0gYygiaGJfbmFtZSIgPSAicmVmZXJlbmNlX2FyZWEiKSkKYGBgCgpgYGB7cn0KbGFiZWxzIDwtIHNwcmludGYoIjxzdHJvbmc+JXM8L3N0cm9uZz48YnIvPiVnIHllYXJzIiwKICAgICAgICAgICAgICAgICAgaGJfc2hhcGVzJGhiX25hbWUsIGhiX3NoYXBlcyRoZWFsdGh5X2xpZmVfZXhwZWN0YW5jeSkgJT4lCiAgbGFwcGx5KGh0bWx0b29sczo6SFRNTCkKYGBgCgoKYGBge3J9CiMgYWRkIEhlYWx0aCBCb2FyZCBwb2x5Z29ucywgY29sb3VyIGJhc2VkIG9uIExFLCBoaWdobGlnaHQgb24gaG92ZXIKCm15X21hcCAlPiUgCiAgICBhZGRQb2x5Z29ucyhkYXRhID0gaGJfc2hhcGVzLCBjb2xvciA9ICJ3aGl0ZSIsCiAgICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+Y29sb3JRdWFudGlsZSgKICAgICAgICAgICAgICAgICAgIllsT3JSZCIsICgtaGJfc2hhcGVzJGhlYWx0aHlfbGlmZV9leHBlY3RhbmN5KSkKICAgICAgICAgICAgICAgICgtaGJfc2hhcGVzJGhlYWx0aHlfbGlmZV9leHBlY3RhbmN5KSwKICAgICAgICAgICAgICAgIHdlaWdodCA9IDEsIGZpbGxPcGFjaXR5ID0gMC45LCBsYWJlbCA9IGxhYmVscywKICAgICAgICAgICAgICAgIGhpZ2hsaWdodE9wdGlvbnMgPSBoaWdobGlnaHRPcHRpb25zKAogICAgICAgICAgICAgICAgICBjb2xvciA9ICJibGFjayIsIHdlaWdodCA9IDIsCiAgICAgICAgICAgICAgICAgIG9wYWNpdHkgPSAwLjksIGJyaW5nVG9Gcm9udCA9IFRSVUUpKQpgYGAKCgoKCgoKCg==